home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xlisp20 / xlisplsp / init.lsp < prev    next >
Text File  |  1990-02-03  |  2KB  |  66 lines
  1. ; get some more memory
  2. (expand 1)
  3.  
  4. ; some fake definitions for Common Lisp pseudo compatiblity
  5. (setq first  car)
  6. (setq second cadr)
  7. (setq rest   cdr)
  8.  
  9. ; some more cxr functions
  10. (defun caddr (x) (car (cddr x)))
  11. (defun cadddr (x) (cadr (cddr x)))
  12.  
  13. ; (when test code...) - execute code when test is true
  14. (defmacro when (test &rest code)
  15.           `(cond (,test ,@code)))
  16.  
  17. ; (unless test code...) - execute code unless test is true
  18. (defmacro unless (test &rest code)
  19.           `(cond ((not ,test) ,@code)))
  20.  
  21. ; (makunbound sym) - make a symbol be unbound
  22. (defun makunbound (sym) (setq sym '*unbound*) sym)
  23.  
  24. ; (objectp expr) - object predicate
  25. (defun objectp (x) (eq (type-of x) :OBJECT))
  26.  
  27. ; (filep expr) - file predicate
  28. (defun filep (x) (eq (type-of x) :FILE))
  29.  
  30. ; (unintern sym) - remove a symbol from the oblist
  31. (defun unintern (sym) (cond ((member sym *oblist*)
  32.                              (setq *oblist* (delete sym *oblist*))
  33.                              t)
  34.                             (t nil)))
  35.  
  36. ; (mapcan ...)
  37. (defmacro mapcan (&rest args) `(apply #'nconc (mapcar ,@args)))
  38.  
  39. ; (mapcon ...)
  40. (defmacro mapcon (&rest args) `(apply #'nconc (maplist ,@args)))
  41.  
  42. ; (save fun) - save a function definition to a file
  43. (defmacro save (fun)
  44.          `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
  45.                  (fval ',fun)
  46.                  (fp (openo fname)))
  47.                 (cond (fp (print (cons (if (eq (car fval) 'lambda)
  48.                                            'defun
  49.                                            'defmacro)
  50.                                        (cons fun (cdr fval))) fp)
  51.                           (close fp)
  52.                           fname)
  53.                       (t nil))))
  54.  
  55. ; (debug) - enable debug breaks
  56. (defun debug ()
  57.        (setq *breakenable* t))
  58.  
  59. ; (nodebug) - disable debug breaks
  60. (defun nodebug ()
  61.        (setq *breakenable* nil))
  62.  
  63. ; initialize to enable breaks but no trace back
  64. (setq *breakenable* t)
  65. (setq *tracenable* nil)
  66. əəəəəəəəəəəəəəəəəəəə